home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d3 / db4less3.arc / EMPRATE.FRG < prev    next >
Encoding:
Text File  |  1990-06-16  |  6.5 KB  |  336 lines
  1. * Program............: D:\DBSYS\CLASSES\BT4W\EMPRATE.FRG
  2. * Date...............: 11-17-88
  3. * Versions...........: dBASE IV, Report 1
  4. *
  5. * Notes:
  6. * ------
  7. * Prior to running this procedure with the DO command
  8. * it is necessary use LOCATE because the CONTINUE
  9. * statement is in the main loop.
  10. *
  11. *-- Parameters
  12. PARAMETERS gl_noeject, gl_plain, gl_summary, gc_heading, gc_extra
  13. ** The first three parameters are of type Logical.
  14. ** The fourth parameter is a string.  The fifth is extra.
  15. PRIVATE _peject, _wrap
  16.  
  17. *-- Test for no records found
  18. IF EOF() .OR. .NOT. FOUND()
  19.    RETURN
  20. ENDIF
  21.  
  22. *-- turn word wrap mode off
  23. _wrap=.F.
  24.  
  25. IF _plength < 10
  26.    SET DEVICE TO SCREEN
  27.    DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
  28.    ACTIVATE WINDOW gw_report
  29.    @ 0,1 SAY "Increase the page length for this report."
  30.    @ 2,1 SAY "Press any key ..."
  31.    x=INKEY(0)
  32.    DEACTIVATE WINDOW gw_report
  33.    RELEASE WINDOW gw_report
  34.    RETURN
  35. ENDIF
  36.  
  37. _plineno=0          && set lines to zero
  38. *-- NOEJECT parameter
  39. IF gl_noeject
  40.    IF _peject="BEFORE"
  41.       _peject="NONE"
  42.    ENDIF
  43.    IF _peject="BOTH"
  44.       _peject="AFTER"
  45.    ENDIF
  46. ENDIF
  47.  
  48. *-- Set-up environment
  49. ON ESCAPE DO prnabort
  50. IF SET("TALK")="ON"
  51.    SET TALK OFF
  52.    gc_talk="ON"
  53. ELSE
  54.    gc_talk="OFF"
  55. ENDIF
  56. gc_space=SET("SPACE")
  57. SET SPACE OFF
  58. gc_time=TIME()      && system time for predefined field
  59. gd_date=DATE()      && system date  "    "    "     "
  60. gl_fandl=.F.        && first and last page flag
  61. gl_prntflg=.T.      && Continue printing flag
  62. gl_widow=.T.        && flag for checking widow bands
  63. gn_length=LEN(gc_heading)  && store length of the HEADING
  64. gn_level=2          && current band being processed
  65. gn_page=_pageno     && grab current page number
  66.  
  67.  
  68.  
  69. *-- Set up procedure for page break
  70. IF _pspacing > 1
  71.    gn_atline=_plength - (_pspacing + 1)
  72. ELSE
  73.    gn_atline=_plength - 2
  74. ENDIF
  75. ON PAGE AT LINE gn_atline EJECT PAGE
  76.  
  77. *-- Print Report
  78.  
  79. PRINTJOB
  80.  
  81. *-- Initialize group break vars.
  82. r_mvar4=DEPT
  83.  
  84. *-- Initialize summary variables.
  85. DECLARE GAVGRATE[3]
  86. STORE 0 TO GAVGRATE[1]
  87. STORE 0 TO GAVGRATE[2],GAVGRATE[3]
  88. DECLARE SAVGRATE[3]
  89. STORE 0 TO SAVGRATE[1]
  90. STORE 0 TO SAVGRATE[2],SAVGRATE[3]
  91.  
  92. IF gl_plain
  93.    ON PAGE AT LINE gn_atline DO Pgplain
  94. ELSE
  95.    ON PAGE AT LINE gn_atline DO Pgfoot
  96. ENDIF
  97.  
  98. DO Pghead
  99.  
  100. gl_fandl=.T.        && first physical page started
  101.  
  102. DO Grphead
  103.  
  104. *-- File Loop
  105. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  106.    DO CASE
  107.    CASE .NOT. (DEPT = r_mvar4)
  108.       gn_level=4
  109.    OTHERWISE
  110.       gn_level=0
  111.    ENDCASE
  112.    *-- test whether an expression didn't match
  113.    IF gn_level <> 0
  114.       DO Grpfoot WITH 100-gn_level
  115.       DO Grpinit
  116.    ENDIF
  117.    *-- Repeat group intros
  118.    IF gn_level <> 0
  119.       DO Grphead
  120.    ENDIF
  121.    DO Upd_Vars
  122.    *-- Detail lines
  123.    IF .NOT. gl_summary
  124.       DO Detail
  125.    ENDIF
  126.    CONTINUE
  127. ENDDO
  128.  
  129. IF gl_prntflg
  130.    gn_level=3
  131.    DO Grpfoot WITH 97
  132.    DO Rsumm
  133.    IF _plineno <= gn_atline
  134.       EJECT PAGE
  135.    ENDIF
  136. ELSE
  137.    gn_level=3
  138.    DO Rsumm
  139.    DO Reset
  140.    RETURN
  141. ENDIF
  142.  
  143. ON PAGE
  144.  
  145. ENDPRINTJOB
  146.  
  147. DO Reset
  148. RETURN
  149. * EOP: D:\DBSYS\CLASSES\BT4W\EMPRATE.FRG
  150.  
  151. *-- Update summary fields and/or calculated fields in the detail band.
  152. PROCEDURE Upd_Vars
  153. *-- Summary calculation - Average
  154. GAVGRATE[1]=GAVGRATE[1]+1              && count
  155. GAVGRATE[2]=GAVGRATE[2]+RATE           && sum
  156. GAVGRATE[3]=GAVGRATE[2]/GAVGRATE[1]    && average
  157. *-- Summary calculation - Average
  158. SAVGRATE[1]=SAVGRATE[1]+1              && count
  159. SAVGRATE[2]=SAVGRATE[2]+RATE           && sum
  160. SAVGRATE[3]=SAVGRATE[2]/SAVGRATE[1]    && average
  161. RETURN
  162. * EOP: Upd_Vars
  163.  
  164. *-- Set flag to get out of DO WHILE loop when escape is pressed.
  165. PROCEDURE prnabort
  166. gl_prntflg=.F.
  167. RETURN
  168. * EOP: prnabort
  169.  
  170. *-- Reset group break variables.  Reinit summary
  171. *-- fields with reset set to a particular group band.
  172. PROCEDURE Grpinit
  173. IF gn_level <= 4
  174.    STORE 0 TO GAVGRATE[1]
  175.    STORE 0 TO GAVGRATE[2],GAVGRATE[3]
  176. ENDIF
  177. IF gn_level <= 4
  178.    r_mvar4=DEPT
  179. ENDIF
  180. RETURN
  181. * EOP: Grpinit
  182.  
  183. *-- Process Group Intro bands during group breaks
  184. PROCEDURE Grphead
  185. IF EOF()
  186.    RETURN
  187. ENDIF
  188. gl_widow=.T.         && enable widow checking
  189. IF gn_level <= 4
  190.    DO Head4
  191. ENDIF
  192. gn_level=0
  193. RETURN
  194. * EOP: Grphead.PRG
  195.  
  196. *-- Process Group Summary bands during group breaks
  197. PROCEDURE Grpfoot
  198. PARAMETER ln_level
  199. IF ln_level >= 96
  200.    DO Foot96
  201. ENDIF
  202. RETURN
  203. * EOP: Grpfoot.PRG
  204.  
  205. PROCEDURE Pghead
  206. IF .NOT. gl_plain
  207.    ?? "Page No." AT 0,
  208.    ?? _pageno PICTURE "999" AT 9
  209. ENDIF
  210. ?
  211. ?? "Report Date:" AT 0,
  212. ?? IIF(gl_plain,'',gd_date) AT 13
  213. ?
  214. ?
  215. *-- Print HEADING parameter ie. REPORT FORM <name> HEADING <expC>
  216. IF .NOT. gl_plain .AND. gn_length > 0
  217.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(_rmargin-_lmargin))
  218.    ?
  219. ENDIF
  220. ?? "EMPLOYEE PAY RATE REPORT" AT 25
  221. ?
  222. ?
  223. ?? ;
  224. "▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒";
  225. + "▒▒▒▒▒▒▒▒▒";
  226. AT 0
  227. ?
  228. ?
  229. RETURN
  230. * EOP: Pghead
  231.  
  232.  
  233. PROCEDURE Head4
  234. IF gn_level=1
  235.    RETURN
  236. ENDIF
  237. IF 7 < _plength
  238.    IF (gl_widow .AND. _plineno+7 > gn_atline) ;
  239.    .OR. (gl_widow .AND. _plineno+6 > gn_atline)
  240.       EJECT PAGE
  241.    ENDIF
  242. ENDIF
  243. ?
  244. DEFINE BOX FROM 5 TO 31 HEIGHT 3 SINGLE
  245. ?
  246. ?? "Department:" AT 8,
  247. ?? DEPT FUNCTION "T" AT 22
  248. ?
  249. ?
  250. ?
  251. ?? "ID" AT 15,
  252. ?? "NAME" AT 22,
  253. ?? "RATE" AT 71
  254. ?
  255. ?
  256. RETURN
  257.  
  258. PROCEDURE Detail
  259. ?? EMPID FUNCTION "T" AT 13,
  260. ?? FNAME FUNCTION "T" AT 22,
  261. ?? " " ,
  262. ?? LNAME FUNCTION "T" ,
  263. ?? RATE PICTURE "999.99" AT 70
  264. ?
  265. RETURN
  266. * EOP: Detail
  267.  
  268. PROCEDURE Foot96
  269. ?
  270. DEFINE BOX FROM 44 TO 77 HEIGHT 3 SINGLE
  271. ?
  272. ?? "Department Average" AT 47,
  273. ?? GAVGRATE[3] PICTURE "9999999.99" AT 66
  274. ?
  275. ?
  276. ?
  277. RETURN
  278.  
  279. PROCEDURE Rsumm
  280. ?
  281. DEFINE BOX FROM 46 TO 77 HEIGHT 3 DOUBLE
  282. ?
  283. ?? "Company Average" AT 49,
  284. ?? SAVGRATE[3] PICTURE "9999999.99" AT 66
  285. ?
  286. ?
  287. gl_fandl=.F.        && last page finished
  288. ?
  289. RETURN
  290. * EOP: Rsumm
  291.  
  292. PROCEDURE Pgfoot
  293. PRIVATE _box
  294. gl_widow=.F.         && disable widow checking
  295. ?
  296. IF .NOT. gl_plain
  297. ENDIF
  298. EJECT PAGE
  299. *-- is the page number greater than the ending page
  300. IF _pageno > _pepage
  301.    GOTO BOTTOM
  302.    SKIP
  303.    gn_level=0
  304. ENDIF
  305. IF .NOT. gl_plain .AND. gl_fandl
  306.    DO Pghead
  307. ENDIF
  308. IF gn_level = 0 .AND. gl_fandl
  309.    gn_level=1
  310.    DO Grphead
  311. ENDIF
  312. gl_widow=.T.         && enable widow checking
  313. RETURN
  314. * EOP: Pgfoot
  315.  
  316. *-- Process page break when PLAIN option is used.
  317. PROCEDURE Pgplain
  318. PRIVATE _box
  319. EJECT PAGE
  320. IF gn_level = 0 .AND. gl_fandl
  321.    gn_level=1
  322.    DO Grphead
  323. ENDIF
  324. RETURN
  325. * EOP: Pgplain
  326.  
  327. *-- Reset dBASE environment prior to calling report
  328. PROCEDURE Reset
  329. SET SPACE &gc_space.
  330. SET TALK &gc_talk.
  331. ON ESCAPE
  332. ON PAGE
  333. RETURN
  334. * EOP: Reset
  335.  
  336.